home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2006 May / PCWMAY06.iso / Software / Trial / ConceptDraw NetDiagrammer / data1.cab / Libraries__Project_Management / Project_Management / GanttChart.cdb < prev    next >
Text File  |  2006-02-08  |  6KB  |  171 lines
  1. Dim TasksTitle As Shape
  2. ' ---------------------------------------------------------------------------
  3. Function IsStarted(this As Shape) As Boolean
  4.     IsStarted = True
  5. End Function
  6. ' ---------------------------------------------------------------------------
  7. Function LineInRect(x1 As Long, y1 As Long, x2 As Long, y2 As Long, rx1 As Long, ry1 As Long, rx2 As Long, ry2 As Long) As Boolean
  8.     LineInRect = False
  9.     If (x1>=rx1 AND x1<=rx2 AND y1>=ry1 AND y1<=ry2) OR (x2>=rx1 AND x2<=rx2 AND y2>=ry1 AND y2<=ry2) Then
  10.         LineInRect = True
  11.     End If
  12. End Function
  13. ' ---------------------------------------------------------------------------
  14. Function FindShapeByName(inPage As Page, inName As String) As Shape
  15.     FindShapeByName = Null
  16.     For I=1 To inPage.ShapesNum()
  17.         If inPage.Shape(I).Name = inName Then
  18.             Set FindShapeByName = inPage.Shape(I)
  19.             Exit Function
  20.         End If
  21.     Next
  22. End Function
  23. ' ---------------------------------------------------------------------------
  24. Function FindShapeByNameInGroup(this As Shape, inName As String) As Shape
  25.     FindShapeByNameInGroup = Null
  26.     For I=1 To this.ShapesNum()
  27.         If this.Shape(I).Name = inName Then
  28.             Set FindShapeByNameInGroup = this.Shape(I)
  29.             Exit Function
  30.         End If
  31.     Next
  32. End Function
  33. ' ---------------------------------------------------------------------------
  34. Function FindBottomTask(inPage As Page, inTaskID As Long) As Shape
  35.     FindBottomTask = Null
  36.     Dim MaxY As Double
  37.  
  38.     MaxY = 0
  39.     For I=1 To inPage.ShapesNum()
  40.         If inPage.Shape(I).Name = "TaskBar" AND inTaskID <> inPage.Shape(I).ID Then
  41.             If inPage.Shape(I).GPinY + inPage.Shape(I).Height > MaxY Then
  42.                 Set FindBottomTask = inPage.Shape(I)
  43.                 MaxY = inPage.Shape(I).GPinY + inPage.Shape(I).Height
  44.             End If
  45.         End If
  46.     Next
  47. End Function
  48. ' ---------------------------------------------------------------------------
  49. Function DelTask(shapeTask As Shape) As Integer
  50. On Error Goto ErrorHandle
  51.     Dim shapeTopTask    As Shape
  52.     Dim shapeBotTask    As Shape
  53.  
  54.     Dim shapeTasksTitle    As Shape
  55.     Set shapeTasksTitle = FindShapeByName(thisDoc.ActivePage, "TasksTitle")
  56.  
  57.     Set shapeTopTask = thisDoc.ActivePage.ShapeByID(shapeTask.CustomProp(4).Value)
  58.     Set shapeBotTask = thisDoc.ActivePage.ShapeByID(shapeTask.CustomProp(5).Value)
  59.  
  60.     If shapeTopTask <> Null Then
  61.         shapeTopTask.CustomProp(5).Value = shapeTask.CustomProp(5).Value
  62.         shapeTopTask.PropertyChanged(CDPT_CUSTOM_VALUE, 5)
  63.     Else
  64.         If shapeBotTask <> Null Then
  65.             shapeBotTask.CustomProp(3).Value = 1
  66.             shapeBotTask.PropertyChanged(CDPT_CUSTOM_VALUE, 3)
  67.             shapeTasksTitle.CustomProp(5).Value = shapeBotTask.ID
  68.         Else
  69.             shapeTasksTitle.CustomProp(5).Value = 0
  70.         End If
  71.     End If
  72.     If shapeBotTask <> Null Then
  73.         shapeBotTask.CustomProp(4).Value = shapeTask.CustomProp(4).Value
  74.         shapeBotTask.SetPropertyFormula(shapeTask.GetPropertyFormula(CDPT_GPINY), CDPT_GPINY)
  75.         shapeBotTask.SetPropertyFormula(shapeTask.GetPropertyFormula(CDPT_CUSTOM_VALUE, 3), CDPT_CUSTOM_VALUE, 3)
  76.  
  77.         shapeBotTask.PropertyChanged(CDPT_CUSTOM_VALUE, 4)
  78.         shapeBotTask.RecalcProperty(CDPT_GPINY)
  79.         shapeBotTask.RecalcProperty(CDPT_CUSTOM_VALUE, 3)
  80.     End If
  81.     Dim shapeLastTask As Shape
  82.     Set shapeLastTask = FindBottomTask(thisDoc.ActivePage, shapeTask.ID)
  83.     If shapeLastTask <> Null Then
  84.         strFormula = "=ObjID" & shapeLastTask.ID & ".GPinY+ObjID" & shapeLastTask.ID & ".Height-Height-GPinY"
  85.         shapeTasksTitle.SetPropertyFormula(strFormula, CDPT_VARIABLE_Y, 2)
  86.         shapeTasksTitle.RecalcProperty(CDPT_VARIABLE_Y, 2)
  87.     End If
  88.  
  89.     Dim shapeTimeLine As Shape
  90.     Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
  91.     Dim rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long
  92.     rx1 = shapeTask.GPinX
  93.     rx2 = shapeTask.GPinX + shapeTask.Width
  94.     ry1 = shapeTask.GPinY
  95.     ry2 = shapeTask.GPinY + shapeTask.Height
  96.     For I=thisDoc.ActivePage.ShapesNum() To 1 Step -1
  97.         If thisDoc.ActivePage.Shape(I).Name = "TimeLineS" Then
  98.             Set shapeTimeLine = thisDoc.ActivePage.Shape(I)
  99.             If NOT shapeTimeLine.Is1D Then
  100.                 x1 = shapeTimeLine.GPinX
  101.                 y1 = shapeTimeLine.GPinY
  102.                 x2 = x1
  103.                 y2 = y1
  104.                 If LineInRect(x1, y1, x2, y2, rx1, ry1, rx2, ry2) = True Then
  105.                     thisDoc.ActivePage.RemoveShapeByID(shapeTimeLine.ID)
  106.                 End If
  107.             End If
  108.         End If
  109.     Next
  110.  
  111.     shapeTask.LockDelete = False
  112.     thisDoc.ActivePage.RemoveShapeByID(shapeTask.ID)
  113. ErrorHandle:
  114. End Function
  115. ' ---------------------------------------------------------------------------
  116. Function GetTasksTitle() As Shape
  117.     Dim libTasksTitle    As Master
  118.     Dim shapeTasksTitle    As Shape
  119.  
  120.     GetTasksTitle = Null
  121.     Set shapeTasksTitle = FindShapeByName(thisDoc.ActivePage, "TasksTitle")
  122.     If shapeTasksTitle = Null Then
  123.         Dim ProjectLib As Library
  124.         Set ProjectLib    = thisApp.OpenLib("Project Management/Gantt Chart Shapes.cdl")
  125.         If ProjectLib = Null Then
  126.             Exit Function
  127.         End If
  128.         Set libTasksTitle = ProjectLib.MasterByName("TasksTitle")
  129.         If libTasksTitle = Null Then
  130.             Exit Function
  131.         End If
  132.         Set shapeTasksTitle = thisDoc.ActivePage.DropStamp(libTasksTitle.Shape, 100, 100)
  133.         shapeTasksTitle.LPinX = 0
  134.         shapeTasksTitle.LPinY = 0
  135.     End If
  136.     Set TasksTitle = shapeTasksTitle
  137.     Set GetTasksTitle = shapeTasksTitle
  138. End Function
  139. ' ---------------------------------------------------------------------------
  140. Sub MenuItemDelTask(cmdArgs As String)
  141.     Dim shapeTask As Shape
  142.     thisDoc.StartRebuild()
  143.     For I=thisDoc.ActiveView.SelectedNum() To 0 Step -1
  144.         Set shapeTask = thisDoc.ActiveView.GetSelectedShape(I)
  145.         If shapeTask <> Null Then
  146.             If shapeTask.Name = "TaskBar" Then
  147.                 DelTask(shapeTask)
  148.             End If
  149.         End If
  150.     Next
  151.     thisDoc.EndRebuild()
  152. End Sub
  153. ' ---------------------------------------------------------------------------
  154. Function MakeGanttMenu() As Integer
  155.     Dim mi As MenuItem
  156.  
  157.     If thisDoc.CustomMenu.MenuItemsNum() = 0 Then
  158.         thisDoc.CustomMenu.Caption = "Gantt Chart"
  159.  
  160.         set mi = thisDoc.CustomMenu.AddMenuItem(0)
  161.         mi.Caption = "Delete Task"
  162.         mi.SetCmdProcessing("MenuItemDelTask")
  163.     End If
  164. End Function
  165. ' ---------------------------------------------------------------------------
  166. Dim shpTasksTitle    As Shape
  167. Set shpTasksTitle = GetTasksTitle()
  168. shpTasksTitle.Variable(3).X = 0
  169. MakeGanttMenu()
  170. ' ---------------------------------------------------------------------------
  171.